*+--------------------------------------------------------------------
*+
*+
*+
*+    Source Module => /home/paul/click/libread.prg
*+
*+
*+
*+    Click! is a Clipper/Xbase++ source code reformatter.
*+
*+    
*+
*+    Note:Phil is no longer actively developing Click!.
*+
*+    Copyright(C) 1996-1999 by Phil Barnett.
*+
*+       
*+
*+    This program is free software; you can redistribute it and/or modify it
*+
*+    under the terms of the GNU General Public License as published by the
*+
*+    Free Software Foundation; either version 2 of the License, or (at your
*+
*+    option) any later version.
*+
*+    
*+
*+    This program is distributed in the hope that it will be useful, but
*+
*+    WITHOUT ANY WARRANTY; without even the implied warranty of
*+
*+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
*+
*+    General Public License for more details.
*+
*+    
*+
*+    You should have received a copy of the GNU General Public License along
*+
*+    with this program; if not, contact the Free Software Foundation, Inc.,
*+
*+    51 Franklin St, Fifth Floor Boston, MA 02110, USA, or www.fsf.org.
*+
*+    
*+
*+    You can contact me at:
*+
*+    
*+
*+    Phil Barnett
*+
*+    Box 944
*+
*+    Plymouth, Florida  32768
*+
*+    
*+
*+    or
*+
*+    
*+
*+    philb@iag.net
*+
*+    
*+
*+    
*+
*+    Ported to Linux and xHarbour compiler, minor feature additions.
*+
*+    Changed version to 3.00xHarbour  Changes
*+
*+    GPL version 3 Copyright (C) 2006-9 by Paul States 
*+
*+    Contact:broadcastmail AT NOSPAM 123mail.org.
*+
*+
*+
*+    Functions: Procedure libread()
*+               Static Function findlibs()
*+               Static Function MyHandler()
*+               Static Procedure dir_recurs()
*+
*+       Tables: use ( cDBFPath ) new exclusive alias CLICK
*+
*+      Indexes: index on fnct+srce tag funct_src unique
*+
*+    Reformatted by Click! 3.00Harbour on Apr-13-2009 at  2:30 pm
*+
*+
*+--------------------------------------------------------------------
*+



#include "common.ch"
#include "fileio.ch"  //FS_SET conflict in flagship 
#include "directry.ch"
#ifdef FlagShip
#define  FS_SET 0 
#endif

static aOutput    := {}
static nLevel     := 0
static nRecursion := 0



*+--------------------------------------------------------------------
*+
*+
*+
*+    Procedure libread()
*+
*+    Called from ( click.prg    )   2 - procedure click()
*+
*+       Calls    ( libread.prg  )   1 - static function findlibs()
*+                ( token.prg    )   1 - function numtoken()
*+                ( profile.prg  )   1 - function profilenum()
*+                ( profile.prg  )   1 - function profilestring()
*+                ( readlist.prg )   1 - function readlist()
*+                ( click.prg    )   2 - function rootname()
*+                ( click.prg    )   3 - procedure show_in()
*+                ( click.prg    )   2 - procedure show_out()
*+                ( token.prg    )   1 - function numtoken()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
procedure libread(cDBFPath,cNSXPath,cClickini)



local x
local nHandle
local cBuffer
local nBytesRead
local nDictOffset
local IDByte        := chr(240)
local nBucket
local cBuffer2
local nDictPages
local y
local nCurrPntr
local nThisDictPage
local cFunction
local nPath
local cPath
local aPaths        := {}
local cThisPath
local cDir
local aFiles
local nFile
local cFileName
local nMaxPathLen
local aFileList
local equ_at
local cLibRead      := ProfileString(cClickini,'CLICK','MAKE_CLICK_DBF_FROM','ENVIRONMENT')

field fnct
field srce

nRecursion := ProfileNum(cClickini,'CLICK','RECURSION_LIMIT',7)

do case
case cLibRead == 'DRIVES'
   cPath := findlibs()
case cLibRead == 'ENVIRONMENT'
   cPath := getenv('LIB')
otherwise
   cPath := cLibRead
endcase

// This section decides how long the longest path is
nMaxPathLen := 0
nPath       := numtoken(cPath,';')
for x := 1 to nPath
   cDir := alltrim(token(cPath,';',x))
   //   cDir += iif( right( cDir, 1 ) <> '\', '\', '' )
   cDir += iif(right(cDir,1) <> '/','/','')
   aadd(aPaths,cDir)
   nMaxPathLen := max(nMaxPathLen,len(cDir))
next

// and adds 12 for the max filename length. XXXXXXXX.XXX = 12
nMaxPathLen += 12

// erase any existing files before beginning.
if file(cDBFPath)
   ferase(cDBFPath)
endif
if file(cNSXPath)
   ferase(cNSXPath)
endif

// create the new CLICK.DBF file
dbcreate(CDBFPATH,{{'FNCT','C',30,0},;
 {'SRCE','C',nMaxPathLen,0}})

use ( cDBFPath ) new exclusive alias CLICK

show_in('Creating '+cDBFPath)

// cycle through each path.
for nPath := 1 to len(aPaths)

   cThisPath := aPaths[nPath]

   aFiles := directory(cThisPath+'*.LIB')

   for nFile := 1 to len(aFiles)

      begin sequence

         cFileName := cThisPath+aFiles[nFile,F_NAME]

         show_in(cThisPath+aFiles[nFile,F_NAME])

         nHandle    := fopen(cFileName,0)   // open read only
         cBuffer    := ' '
         nBytesRead := fread(nHandle,@cBuffer,1)

         // if bad handle, or first byte is not chr( 240 ) (microsoft object)
         // skip this one

         if nHandle == - 1 .or. cBuffer <> IDByte
            break
         endif

         // go to the third byte
         fseek(nHandle,3,FS_SET)

         // read in 4 bytes
         cBuffer    := space(4)
         nBytesRead := fread(nHandle,@cBuffer,4)
         // This is the start of the library dictionary
         nDictOffset := bin2l(cBuffer)

         // read in the next 2 bytes
         cBuffer    := space(2)
         nBytesRead := fread(nHandle,@cBuffer,2)
         // This is how many 37 entry, 512 byte sections there are
         nDictPages := bin2i(cBuffer) - 1   // 0 offset reference

         for y := 0 to nDictPages

            // get a pointer to the dictionary page
            nThisDictPage := nDictOffset+(y * 512)

            // can we go to that offset?
            if fseek(nHandle,nThisDictPage,FS_SET) <> nThisDictPage
               break
            endif

            // read in the 37 byte string for 37 buckets
            cBuffer := space(37)
            fread(nHandle,@cBuffer,37)

            for x := 1 to 37

               // Take the ascii value of the bucket (0 - 255), but since
               // the dictionary page is 512, this value is multiplied by 2
               // to get the pointer offset.
               // the last of the valid buckets is followed by a 0.
               nBucket := asc(substr(cBuffer,x,1)) * 2

               if !empty(nBucket)

                  // we found a good pointer, go to it's location in the file
                  // and read in 30 bytes.
                  nCurrPntr := nThisDictPage+nBucket
                  cBuffer2  := space(30)
                  fseek(nHandle,nCurrPntr,FS_SET)
                  fread(nHandle,@cBuffer2,30)

                  // the first byte tells how long the entry is, grab it
                  // and remove it and chop the string off at the endpoint
                  cFunction := substr(cBuffer2,2,asc(left(cBuffer2,1)))

                  // Many entries have a ! at the end. I'm sure it means
                  // something, but I have no idea what. In any case, it
                  // gets removed here.
                  if right(cFunction,1) == '!'
                     cFunction := left(cFunction,len(cFunction) - 1)
                  endif

                  // now, we convert to lower case and store it in CLICK.DBF
                  click->(dbappend())
                  click->fnct := lower(cFunction)
                  click->srce := cFileName

                  show_out(cFunction)

               endif
            next
         next
      end sequence
      if nHandle > - 1
         fclose(nHandle)
      endif
   next
next

// This section reads in the CLICKFNC.INI file and appends the contents
// to the CLICK.DBF file.

if file(rootname(cDBFPath)+'FNC.INI')
   aFileList := readlist(rootname(cDBFPath)+'FNC.INI','@')
   for x := 1 to len(aFileList)
      click->(dbappend())
      equ_at := at('=',aFileList[x])
      if equ_at > 0
         click->fnct := lower(alltrim(left(aFileList[x],equ_at - 1)))
         click->srce := upper(alltrim(substr(aFileList[x],equ_at+1)))
         click->(dbcommit())
         click->(dbunlock())
         show_out(aFileList[x])
      endif
   next
endif

// last step is to create the index. Creating the index last creates a
// smaller index size.

show_in('Creating '+cNSXPath+' for '+cDBFPath)
index on fnct+srce tag funct_src unique

return



*+--------------------------------------------------------------------
*+
*+
*+
*+    Static Function findlibs()
*+
*+    Called from ( libread.prg  )   1 - procedure libread()
*+
*+       Calls    ( libread.prg  )   1 - static procedure dir_recurs()
*+                ( libread.prg  )   1 - static function myhandler()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
static function findlibs()



local aDrive    := {}
local aCapacity := {}
local cOutPut   := ''
local X
local nX
local Y
local nY
local nThisSize
local bOldError

// This error block is only for continuing after DISKSPACE() returns
// an error condition. Returning .f. causes DISKSPACE() to return 0

bOldError := errorblock({| oErr | MyHandler(oErr)})

// first, scan through the drives and figure out which ones are duplicates...

for x := 3 to 26

   nThisSize := diskspace(x)

   if nThisSize > 0 .and. ascan(aCapacity,nThisSize) == 0
      aadd(aDrive,chr(x+64))
      aadd(aCapacity,nThisSize)
   endif

next

errorblock(bOldError)

// Then, process each drive via recursion

nX := len(aDrive)
for x := 1 to nX

   aOutput := {}
   dir_recurs(aDrive[x]+':')

   nY := len(aOutput)
   for y := 1 to nY
      if !empty(aOutput[y])
         cOutput += aOutput[y]+';'
      endif
   next

next

return cOutPut



*+--------------------------------------------------------------------
*+
*+
*+
*+    Static Function MyHandler()
*+
*+    Called from ( libread.prg  )   1 - static function findlibs()
*+
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
static function MyHandler(oErr)

LOCAL otemp
otemp := oErr   //stop unused variable message 2/09

return .f.



*+--------------------------------------------------------------------
*+
*+
*+
*+    Static Procedure dir_recurs()
*+
*+    Called from ( libread.prg  )   1 - static function findlibs()
*+                                   1 - static procedure dir_recurs()
*+
*+       Calls    ( libread.prg  )   1 - static procedure dir_recurs()
*+                ( click.prg    )   1 - procedure show_in()
*+                ( click.prg    )   1 - procedure show_out()
*+
*+
*+
*+--------------------------------------------------------------------
*+
*+
*+
static procedure dir_recurs(cPath)



local x
local aFiles    := directory(cPath+'\*.*','D')
local nFilCount := len(aFiles)

for x := 1 to nFilCount

   do case
   case aFiles[X,F_NAME] == '..' .or. aFiles[X,F_NAME] == '.'

      loop

   case 'D' $ aFiles[X,F_ATTR]

      if ++ nLevel < nRecursion
         show_in(cPath+'/'+aFiles[X,F_NAME])
         DIR_RECURS(cPath+'/'+aFiles[X,F_NAME])
      endif
      nLevel --

   case '.LIB' $ aFiles[X,F_NAME]

      if ascan(aOutput,cPath) == 0
         aadd(aOutput,cPath)
         SHOW_OUT(cPath)
      endif

   endcase

next

return



*+ EOF: libread.prg
*+
